home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / xf2.3-p / xf2 / xf2.3 / elements / Listbox < prev    next >
Encoding:
Text File  |  1993-11-20  |  8.5 KB  |  259 lines
  1. # Program: xf
  2. # Description: handle listbox widgets
  3. #
  4. # $Header: Listbox[2.4] Wed Mar 10 11:58:50 1993 garfield@garfield frozen $
  5.  
  6. global xfDefaultConf
  7. set xfDefaultConf(listbox) 4
  8.  
  9. ##########
  10. # Procedure: XFAdd.Listbox
  11. # Description: add a listbox
  12. # Arguments: xfW - the widget
  13. #            xfName - a optional name
  14. #            xfType - add or config
  15. # Returns: none
  16. # Sideeffects: none
  17. ##########
  18. proc XFAdd.Listbox {xfW xfName xfType} {
  19.   global xfStatus
  20.  
  21.   XFEditSetStatus "Inserting Listbox..."
  22.   set xfName [XFMiscGetUniqueName $xfName listbox]
  23.   if {"$xfStatus(path)" == "."} {
  24.     if {"$xfType" == "add"} {
  25.       listbox .$xfName \
  26.         -geometry 10x2 \
  27.         -relief raised
  28.     } {
  29.       listbox .$xfName
  30.     }
  31.     .$xfName insert 0 "$xfName"
  32.  
  33.     XFMiscPositionWidget .$xfName
  34.     XFMiscBindWidgetTree .$xfName
  35.   } {
  36.     if {"$xfType" == "add"} {
  37.       listbox $xfStatus(path).$xfName \
  38.         -geometry 10x2 \
  39.         -relief raised
  40.     } {
  41.       listbox $xfStatus(path).$xfName
  42.     }
  43.     $xfStatus(path).$xfName insert 0 "$xfName"
  44.  
  45.     XFMiscPositionWidget $xfStatus(path).$xfName
  46.     XFMiscBindWidgetTree $xfStatus(path).$xfName
  47.   }
  48.  
  49.   incr xfStatus(elementCounter)
  50.   XFEditSetPath $xfStatus(path)
  51.   XFEditSetStatus "Inserting Listbox...done"
  52. }
  53.  
  54. ##########
  55. # Procedure: XFConfig.Listbox4
  56. # Description: configure a listbox
  57. # Arguments: xfW - the widget
  58. #            xfType - config type (add config)
  59. #            xfClass - the class we configure
  60. #            xfLeader - the leading window
  61. # Returns: none
  62. # Sideeffects: none
  63. ##########
  64. proc XFConfig.Listbox4 {xfW xfType xfClass {xfLeader ""}} {
  65.   global xfConf
  66.   global xfStatus
  67.   global xfMisc
  68.  
  69.   set xfMisc(singleSelection) 0  
  70.   if {"$xfType" == "add"} {
  71.     set xfName listbox$xfStatus(elementCounter)
  72.   } {
  73.     set xfName [XFMiscPathName $xfW]
  74.   }
  75.   XFEditSetStatus "Calling parameter setting for Listbox..."
  76.  
  77.   # build widget structure
  78.   XFTmpltToplevel .xf${xfClass}Config4 400x580 \
  79.     "Listbox parameters:[XFMiscPathTail $xfW]" $xfLeader
  80.  
  81.   XFElementInit $xfW .xf${xfClass}Config4 $xfType $xfClass \
  82.     XFListboxSetListbox4 parameters $xfName 4
  83.   XFElementColor $xfW .xf${xfClass}Config4 $xfType $xfClass bg \
  84.     background Background "Background" XFListboxSetListbox4
  85.   XFElementScale $xfW .xf${xfClass}Config4 $xfType $xfClass borderwidth \
  86.     borderWidth BorderWidth "Border width" "pixels" 40 XFListboxSetListbox4
  87.   XFElementBoolean $xfW .xf${xfClass}Config4 $xfType $xfClass exportSelection \
  88.     "Export selection" XFListboxSetListbox4
  89.   XFElementFont $xfW .xf${xfClass}Config4 $xfType $xfClass font \
  90.     font Font "Font" XFListboxSetListbox4
  91.   if {$xfConf(kanji)} {
  92.     XFElementFont $xfW .xf${xfClass}Config4 $xfType $xfClass kanjifont \
  93.       kanjiFont KanjiFont "Kanji font" XFListboxSetListbox4
  94.   }
  95.   XFElementColor $xfW .xf${xfClass}Config4 $xfType $xfClass fg \
  96.     foreground Foreground "Foreground" XFListboxSetListbox4
  97.   XFElementGeometry $xfW .xf${xfClass}Config4 $xfType $xfClass \
  98.     XFListboxSetListbox4
  99.   XFElementRelief $xfW .xf${xfClass}Config4 $xfType $xfClass \
  100.     XFListboxSetListbox4
  101.  
  102.   XFTmpltFrame .xf${xfClass}Config4.params1.params2.frame9 0
  103.  
  104.   checkbutton .xf${xfClass}Config4.params1.params2.frame9.singlesel \
  105.     -text "Single selection" \
  106.     -variable xfMisc(singleSelection) \
  107.     -command "XFListboxSetListbox4 $xfW 0 $xfClass"
  108.   pack append .xf${xfClass}Config4.params1.params2.frame9 \
  109.               .xf${xfClass}Config4.params1.params2.frame9.singlesel {top frame center}
  110.   pack append .xf${xfClass}Config4.params1.params2 \
  111.               .xf${xfClass}Config4.params1.params2.frame9 {top fill pady 6}
  112.  
  113.   XFElementText $xfW .xf${xfClass}Config4 $xfType $xfClass xcommand \
  114.     xScrollCommand XScrollCommand "X scroll command" XFListboxSetListbox4
  115.   XFElementText $xfW .xf${xfClass}Config4 $xfType $xfClass ycommand \
  116.     yScrollCommand YScrollCommand "Y scroll command" XFListboxSetListbox4
  117.  
  118.   if {"$xfType" == "add"} {
  119.     .xf${xfClass}Config4.params1.params2.geo.geo1.geo1 set 10
  120.     .xf${xfClass}Config4.params1.params2.geo.geo2.geo2 set 2
  121.   } {
  122.     if {!("[bind $xfW <B1-Motion>]" == {} ||
  123.           "[bind $xfW <B1-Motion>]" == {%W select to [%W nearest %y]} ||
  124.           "[bind $xfW <B1-Motion>]" == {# xf ignore me 9
  125.   %W select to [%W nearest %y]})} {
  126.       set xfMisc(singleSelection) 1
  127.     }
  128.   }
  129.  
  130.   label .xf${xfClass}Config4.params1.params2.contentsMess \
  131.     -relief flat \
  132.     -anchor c \
  133.     -text "Current contents of list:"
  134.  
  135.   set xfContents ""
  136.   if {"$xfType" == "add"} {
  137.     set xfContents $xfName
  138.   } {
  139.     set xfListLength [$xfW size]
  140.     set xfCounter 0
  141.     while {$xfCounter < $xfListLength} {
  142.       append xfContents "[$xfW get $xfCounter]\n"
  143.       incr xfCounter 1
  144.     }
  145.   }
  146.   XFTmpltText .xf${xfClass}Config4.params1.params2 contents 0 $xfContents
  147.  
  148.   # save current parameter
  149.   if {$xfConf(kanji)} {
  150.     XFElementSave $xfW $xfClass {background borderwidth exportselection font kanjifont foreground geometry relief xscrollcommand yscrollcommand}
  151.   } {
  152.     XFElementSave $xfW $xfClass {background borderwidth exportselection font foreground geometry relief xscrollcommand yscrollcommand}
  153.   }
  154.  
  155.   # packing
  156.   pack append .xf${xfClass}Config4.params1.params2 \
  157.               .xf${xfClass}Config4.params1.params2.contentsMess {top fillx padx 6} \
  158.               .xf${xfClass}Config4.params1.params2.contents {top fill expand}
  159.   pack append .xf${xfClass}Config4.params1 \
  160.               .xf${xfClass}Config4.params1.params2 {left fill expand}
  161.   pack append .xf${xfClass}Config4 \
  162.               .xf${xfClass}Config4.pathname {top fill frame center} \
  163.               .xf${xfClass}Config4.leave {bottom fill} \
  164.               .xf${xfClass}Config4.additional {bottom fill} \
  165.               .xf${xfClass}Config4.params1 {top fill expand}
  166.  
  167.   XFBindFormConnect .xf${xfClass}Config4.params1.params2 \
  168.     "XFListboxSetListbox4 $xfW 0 $xfClass"
  169.  
  170.   XFEditSetStatus "Calling parameter setting for Listbox...done"
  171. }
  172.  
  173. ##########
  174. # Procedure: XFSaveSpecial.Listbox
  175. # Description: save listbox
  176. # Arguments: xfW - the widget
  177. # Returns: none
  178. # Sideeffects: none
  179. ##########
  180. proc XFSaveSpecial.Listbox {xfW} {
  181.  
  182.   set xfCounter 0
  183.   set xfLast [$xfW size]
  184.   set xfResult ""
  185.   while {$xfCounter < $xfLast} {
  186.     append xfResult "  $xfW insert end \{[$xfW get $xfCounter]\}\n"
  187.     incr xfCounter 1
  188.   }
  189.   return $xfResult
  190. }
  191.  
  192. ##########
  193. # Procedure: XFListboxSetListbox4
  194. # Description: set listbox parameters
  195. # Arguments: xfW - the widget
  196. #            xfType - the type of setting (1 = set always, 0 = set
  197. #                     only if permanent apply is on)
  198. #            xfClass - the class we configure
  199. #            xfParam1 - ignored parameter
  200. # Returns: none
  201. # Sideeffects: none
  202. ##########
  203. proc XFListboxSetListbox4 {xfW xfType xfClass {xfParam1 ""}} {
  204.   global xfConf
  205.   global xfMisc
  206.  
  207.   if {$xfType == 0 && !$xfConf(applyParameters)} {
  208.     return
  209.   }
  210.   if {"[info commands $xfW]" == ""} {
  211.     return
  212.   }
  213.   XFMiscSetSymbolicName $xfW \
  214.     [.xf${xfClass}Config4.params1.params2.symname.symname get]
  215.  
  216.   XFMiscSetResource $xfW background \
  217.     [.xf${xfClass}Config4.params1.params2.bg.bg get]
  218.   XFMiscSetResource $xfW borderwidth \
  219.     [.xf${xfClass}Config4.params1.params2.borderwidth.borderwidth get]
  220.   XFMiscSetResource $xfW exportselection $xfMisc(exportSelection)
  221.   XFMiscSetResource $xfW font \
  222.     [.xf${xfClass}Config4.params1.params2.font.font get]
  223.   if {$xfConf(kanji)} {
  224.     XFMiscSetResource $xfW kanjifont \
  225.       [.xf${xfClass}Config4.params1.params2.kanjifont.kanjifont get]
  226.   }
  227.   XFMiscSetResource $xfW foreground \
  228.     [.xf${xfClass}Config4.params1.params2.fg.fg get]
  229.   if {[.xf${xfClass}Config4.params1.params2.geo.geo1.geo1 get] > 0 &&
  230.       [.xf${xfClass}Config4.params1.params2.geo.geo2.geo2 get] > 0} {
  231.     XFMiscSetResource $xfW geometry \
  232.       "[.xf${xfClass}Config4.params1.params2.geo.geo1.geo1 get]x[.xf${xfClass}Config4.params1.params2.geo.geo2.geo2 get]"
  233.   }
  234.   XFMiscSetResource $xfW relief $xfMisc(relief)
  235.   XFMiscSetResource $xfW xscrollcommand \
  236.     [.xf${xfClass}Config4.params1.params2.xcommand.xcommand get]
  237.   XFMiscSetResource $xfW yscrollcommand \
  238.     [.xf${xfClass}Config4.params1.params2.ycommand.ycommand get]
  239.   
  240.   XFMiscClearList $xfW
  241.   set xfContents [string trim [XFMiscGetText .xf${xfClass}Config4.params1.params2.contents.contents]]
  242.   foreach xfCounter [split $xfContents [format "%s" "\n"]] {
  243.     $xfW insert end $xfCounter
  244.   }
  245.  
  246.   if {$xfMisc(singleSelection)} {
  247.     bind $xfW <B1-Motion> {%W select from [%W nearest %y]} 
  248.     bind $xfW <Shift-1> {%W select from [%W nearest %y]}
  249.     bind $xfW <Shift-B1-Motion> {%W select from [%W nearest %y]}
  250.   } {
  251.     bind $xfW <B1-Motion> {}
  252.     bind $xfW <Shift-1> {}
  253.     bind $xfW <Shift-B1-Motion> {}
  254.   }
  255. }
  256.  
  257. # eof
  258.  
  259.